COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 The Italian eval from 1975 and comparisons.
C00010 00003	(DEfun VUIL (X Y) (IF (EQUAL X '0) (ADD1 Y) (IF (EQUAL Y '0) (VUIL (SUB1 X) '1)
C00011 ENDMK
C⊗;
;;; The Italian eval from 1975 and comparisons.

;;; old eval with counter of function calls.  All (setq count ...)
;;; are for comparison purposes only.

(DEFUN OEV (U V) 
       ((LAMBDA (M N) (LIST (OEVAL U V) COUNT C2))
	(SETQ COUNT 0)
	(SETQ C2 0)))
 

;;; This one calls reval1 and doesn't use c2.
(DEFUN REV1 (U V) 
       ((LAMBDA (M) (CONS (REVAL1 U V) COUNT)) (SETQ COUNT 0)))
 
;;; calls reval
(DEFUN REV (U V) 
       ((LAMBDA (M N) (LIST (REVAL U V) COUNT C2))
	(SETQ COUNT 0)
	(SETQ C2 0)))
 
;;; a version of subst as data for evaluators
(DEFUN SUBB (X Y Z) 
       (IF (ATOM Z)
	   (IF (EQ Y Z) X Z)
	   (CONS (SUBB X Y (CAR Z)) (SUBB X Y (CDR Z)))))
 
;;; presumably the old evaluator eval in some incarnation
;;; maybe just with counters.  Uses eval for applying elementary
;;; functions to constant arguments.
;;; Calls oeval2
;;; to get function definitions from property lists.
;;; Doesn't allow λ-applications.
(DEFUN OEVAL (E A) 
       ((LAMBDA (V) 
	 (COND
	  ((ATOM E) (CDR (ASSOC E A)))
	  ((EQ (CAR E) 'QUOTE) (CADR E))
	  ((EQ (CAR E) 'IF)
	   (COND ((OEVAL (CADR E) A) (OEVAL (CADDR E) A))
		 (T (OEVAL (CADDDR E) A))))
	  ((MEMBER (CAR E) ELEM)
	   (EVAL (CONS (CAR E)
		       (MAPCAR (FUNCTION (LAMBDA (W) 
						 (LIST 'QUOTE
						       (OEVAL W A))))
			       (CDR E)))))
	  (T (OEVAL2 E A))))
	(SETQ COUNT (ADD1 COUNT))))
 

(DEFUN OEVAL2 (E A) 
       ((LAMBDA (X) 
	 ((LAMBDA (Z) 
	   (OEVAL (CADDR Z)
		  (APPEND (PRUP (CADR Z)
				(MAPCAR 
				 (FUNCTION (LAMBDA (W) (OEVAL W A)))
				 (CDR E)))
			  A)))
	  (GET (CAR E) 'EXPR)))
	(SETQ C2 (ADD1 C2))))
 
;;; When reval1 looks up an atom on the alist, it finds an
;;; expression-alist pair and evaluates the expression and alist.
;;; The simplest case would then be (QUOTE ...) paired with NIL.
;;; Example: (reval1 'u x1) gives (a b).
;;; The other key case is when the function is defined by an EXPR
;;; on its property list to be a λ-expression.  We then evaluate
;;; the body of the lambda expression, pairing the variables of
;;; the λ-expression with the formal arguments (a1 ... an)
(DEFUN REVAL1 (E A) 
       ((LAMBDA (V) 
	 (COND
	  ((ATOM E)
	   ((LAMBDA (W) (REVAL1 (CAR W) (CADR W))) (CDR (ASSOC E A))))
	  ((EQ (CAR E) 'QUOTE) (CADR E))
	  ((EQ (CAR E) 'IF)
	   (COND ((REVAL1 (CADR E) A) (REVAL1 (CADDR E) A))
		 (T (REVAL1 (CADDDR E) A))))
	  ((MEMBER (CAR E) ELEM)
	   (EVAL (CONS (CAR E)
		       (MAPCAR (FUNCTION (LAMBDA (W) 
						 (LIST 'QUOTE
						       (REVAL1 W A))))
			       (CDR E)))))
	  (T
	   ((LAMBDA (W) 
	     (REVAL1
	      (CADDR W)
	      (APPEND (PRUP (CADR W)
			    (MAPCAR (FUNCTION (LAMBDA (Z) (LIST Z A)))
				    (CDR E)))
		      A)))
	    (GET (CAR E) 'EXPR)))))
	(SETQ COUNT (ADD1 COUNT))))
 

;;; reval is like reval1 except that when an atom gets evaluated,
;;; the expression with which it was originally paired in the alist
;;; is replaced by the quoted value found using rplacd.
(DEFUN REVAL (E A) 
       ((LAMBDA (V) 
	 (COND
	  ((ATOM E)
	   ((LAMBDA (W) ((LAMBDA (Z) 
				 ((LAMBDA (U) Z)
;;; Here's the rplacd.
				  (RPLACD W
					  (LIST (LIST 'QUOTE Z)
						NIL))))
			 (REVAL (CADR W) (CADDR W))))
	    (ASSOC E A)))
	  ((EQ (CAR E) 'QUOTE) (CADR E))
	  ((EQ (CAR E) 'IF)
	   (COND ((REVAL (CADR E) A) (REVAL (CADDR E) A))
		 (T (REVAL (CADDDR E) A))))
	  ((MEMBER (CAR E) ELEM)
	   (EVAL (CONS (CAR E)
		       (MAPCAR (FUNCTION (LAMBDA (W) 
						 (LIST 'QUOTE
						       (REVAL W A))))
			       (CDR E)))))
	  (T (REVAL2 E A))))
	(SETQ COUNT (ADD1 COUNT))))
 

;;; I suppose C2 is the count of how many times the evaluation
;;; calls a function from its property list.
(DEFUN REVAL2 (E A) 
       ((LAMBDA (X) 
	 ((LAMBDA (W) 
	   (REVAL (CADDR W)
		  (APPEND (PRUP (CADR W)
				(MAPCAR 
				 (FUNCTION (LAMBDA (Z) (LIST Z A)))
				 (CDR E)))
			  A)))
	  (GET (CAR E) 'EXPR)))
	(SETQ C2 (ADD1 C2))))
 


;;; our old friend that pairs up two lists
(DEFUN PRUP (U V) 
       (COND ((NULL U) NIL)
	     (T (CONS (CONS (CAR U) (CAR V))
		      (PRUP (CDR U) (CDR V))))))
 
;;; setqs of variables.  These were defprops in the original.

(setq COUNT 0)

(setq ELEM
'(ATOM EQ EQUAL CAR CDR CONS NULL LIST CADR CAAR CDAR CDDR PLUS DIFFERENCE
ADD1 SUB1)
)

;;;test alist for reval and reval1
(setq X1
'((U (QUOTE (A B)) NIL) (V (QUOTE C) NIL) (W (QUOTE (C . C)) NIL))
)

;;; this alist is suitable for oeval
(setq X2
'((U A B) (V . C) (W C . C))
)

;;; An expression for evaluation by any of the evals.
(setq X3
'(SUBB (QUOTE A) (QUOTE X) (QUOTE (((X . X) (X . X)) (X . X) X . X)))
)
(DEfun VUIL (X Y) (IF (EQUAL X '0) (ADD1 Y) (IF (EQUAL Y '0) (VUIL (SUB1 X) '1)
	(VUIL (SUB1 X) (VUIL X (SUB1 Y))))))

(SETQ x4 '(VUIL '0 '0))

(SETQ x5 '(VUIL '2 '1))

(DEfun MANNA (X Y)
 (IF (EQUAL X '0) '1 (MANNA (SUB1 X) (MANNA (DIFFERENCE X Y) Y))))

(SETQ x6 '(MANNA '0 '0))

(SETQ x7 '(MANNA '2 '1))

(defun lose (x y) (if (equal x '0) '0 (add1 (lose (sub1 x) (lose (add1 x) 0)))))

;;; This is the example on which rev and rev1 win and oev gives pdl overflow.
(setq x8 '(lose '1 '0))